﻿Imports System.Data
Imports System.Collections
Imports System.Globalization
Imports System.Text

Public Class JSON

    Public Const TOKEN_NONE As Integer = 0
    Public Const TOKEN_CURLY_OPEN As Integer = 1
    Public Const TOKEN_CURLY_CLOSE As Integer = 2
    Public Const TOKEN_SQUARED_OPEN As Integer = 3
    Public Const TOKEN_SQUARED_CLOSE As Integer = 4
    Public Const TOKEN_COLON As Integer = 5
    Public Const TOKEN_COMMA As Integer = 6
    Public Const TOKEN_STRING As Integer = 7
    Public Const TOKEN_NUMBER As Integer = 8
    Public Const TOKEN_TRUE As Integer = 9
    Public Const TOKEN_FALSE As Integer = 10
    Public Const TOKEN_NULL As Integer = 11

    Private Const BUILDER_CAPACITY As Integer = 2000

    Friend Shared instance As JSON = New JSON

    '/// <summary>
    '/// On decoding, this value holds the position at which the parse failed (-1 = no error).
    '/// </summary>
    Friend lastErrorIndex As Integer = -1
    Friend lastDecode As String = ""

    Private Shared unixEpoch As DateTime = New DateTime(1970, 1, 1, 0, 0, 0, 0, DateTimeKind.Utc)

    '/// <summary>
    '/// Parses the json date_epoch into a .Net Date
    '/// </summary>
    '/// <param name="date_epoch">A JSON date_epoch string.</param>
    '/// <returns>A .NET date</returns>
    Public Shared Function DecodeDateTime(ByVal date_epoch As String) As Date
        Return unixEpoch.AddSeconds(Convert.ToDouble(date_epoch)) 'this.MyDateTime - unixEpoch).TotalSeconds
    End Function

    Public Shared Function ToInteger(ByVal Value As String) As Integer
        Select Case Integer.TryParse(Value, 0) 'IsNumeric(Value)
            Case True : Return CInt(Value)
            Case False : Return 0
        End Select
    End Function

    '/// <summary>
    '/// Parses the string json into a value
    '/// </summary>
    '/// <param name="jsonText">A JSON string.</param>
    '/// <returns>An ArrayList, a Hashtable, a double, a string, null, true, or false</returns>
    Public Shared Function JsonDecode(ByVal jsonText As String) As Object

        ' save the string for debug information
        JSON.instance.lastDecode = jsonText

        If Not jsonText = "" Then
            Dim charArray() As Char = jsonText.ToCharArray
            Dim index As Integer = 0
            Dim success As Boolean = True
            Dim value As Object = JSON.instance.ParseValue(charArray, index, success)
            If success Then
                JSON.instance.lastErrorIndex = -1
            Else
                JSON.instance.lastErrorIndex = index
            End If
            Return value
        Else
            Return Nothing
        End If

    End Function

    '/// <summary>
    '/// Converts a Hashtable / ArrayList object into a JSON string
    '/// </summary>
    '/// <param name="json">A Hashtable / ArrayList</param>
    '/// <returns>A JSON encoded string, or null if object 'json' is not serializable</returns>
    Public Shared Function JsonEncode(ByVal json As Object) As String

        Dim builder As StringBuilder = New StringBuilder(BUILDER_CAPACITY)
        Dim success As Boolean = json.instance.SerializeValue(json, builder)
        If success Then
            Return builder.ToString
        Else
            Return Nothing
        End If

    End Function

    '/// <summary>
    '/// On decoding, this function returns the position at which the parse failed (-1 = no error).
    '/// </summary>
    '/// <returns></returns>
    Public Shared Function LastDecodeSuccessful() As Boolean
        Return (JSON.instance.lastErrorIndex = -1)
    End Function

    '/// <summary>
    '/// On decoding, this function returns the position at which the parse failed (-1 = no error).
    '/// </summary>
    '/// <returns></returns>
    Public Shared Function GetLastErrorIndex() As Integer
        Return JSON.instance.lastErrorIndex
    End Function

    '/// <summary>
    '/// If a decoding error occurred, this function returns a piece of the JSON string 
    '/// at which the error took place. To ease debugging.
    '/// </summary>
    '/// <returns></returns>
    Public Shared Function GetLastErrorSnippet() As String

        If (JSON.instance.lastErrorIndex = -1) Then
            Return ""
        Else
            Dim startIndex As Integer = JSON.instance.lastErrorIndex - 5
            Dim endIndex As Integer = JSON.instance.lastErrorIndex + 15
            If (startIndex < 0) Then
                startIndex = 0
            End If
            If (endIndex >= JSON.instance.lastDecode.Length) Then
                endIndex = JSON.instance.lastDecode.Length - 1
            End If

            Return JSON.instance.lastDecode.Substring(startIndex, endIndex - startIndex + 1)
        End If

    End Function

    Friend Function ParseObject(ByVal json As Char(), ByRef index As Integer) As Hashtable

        Dim table As Hashtable = New Hashtable()
        Dim token As Integer

        ' {
        NextToken(json, index)

        Dim done As Boolean = False

        While Not done
            token = LookAhead(json, index)
            Select Case token

                Case TOKEN_NONE
                    Return Nothing

                Case TOKEN_COMMA
                    NextToken(json, index)

                Case TOKEN_CURLY_CLOSE
                    NextToken(json, index)
                    Return table

                Case Else

                    ' name
                    Dim name As String = ParseString(json, index)
                    If (name = Nothing) Then
                        Return Nothing
                    End If

                    ' :
                    token = NextToken(json, index)
                    If (token <> TOKEN_COLON) Then
                        Return Nothing
                    End If

                    ' value
                    Dim success As Boolean = True
                    Dim value As Object = ParseValue(json, index, success)
                    If Not success Then
                        Return Nothing
                    End If

                    table(name) = value

            End Select

        End While

        Return table

    End Function

    Friend Function ParseArray(ByVal json As Char(), ByRef index As Integer) As ArrayList

        Dim array As ArrayList = New ArrayList

        ' [
        NextToken(json, index)

        Dim done As Boolean = False

        While Not done
            Dim token As Integer = LookAhead(json, index)
            Select Case token
                Case TOKEN_NONE
                    Return Nothing

                Case TOKEN_COMMA
                    NextToken(json, index)

                Case TOKEN_SQUARED_CLOSE
                    NextToken(json, index)
                    Exit While

                Case Else
                    Dim success = True
                    Dim value As Object = ParseValue(json, index, success)
                    If Not success Then
                        Return Nothing
                    End If

                    array.Add(value)
            End Select

        End While

        Return array

    End Function

    Friend Function ParseValue(ByVal json As Char(), ByRef index As Integer, ByRef success As Boolean) As Object

        Select Case LookAhead(json, index)
            Case TOKEN_STRING
                Return ParseString(json, index)
            Case TOKEN_NUMBER
                Return ParseNumber(json, index)
            Case TOKEN_CURLY_OPEN
                Return ParseObject(json, index)
            Case TOKEN_SQUARED_OPEN
                Return ParseArray(json, index)
            Case TOKEN_TRUE
                NextToken(json, index)
                Return Boolean.Parse("TRUE")
            Case TOKEN_FALSE
                NextToken(json, index)
                Return Boolean.Parse("FALSE")
            Case TOKEN_NULL
                NextToken(json, index)
                Return Nothing
            Case TOKEN_NONE
                '
        End Select

        success = False
        Return Nothing

    End Function

    Friend Function ParseString(ByVal json As Char(), ByRef index As Integer) As String

        Dim s As String = ""
        Dim c As Char

        EatWhitespace(json, index)

        ' "
        c = json(index)
        index += 1

        Dim complete As Boolean = False
        While Not complete

            If index = json.Length Then
                Exit While
            End If

            c = json(index)
            index += 1
            If c = ControlChars.Quote Then
                complete = True
                Exit While
            ElseIf c = "\" Then

                If index = json.Length Then
                    Exit While
                End If
                c = json(index)
                index += 1
                Select Case c

                    Case ControlChars.Quote : s += ControlChars.Quote
                    Case "\" : s += "\"
                    Case "/" : s += "/"
                    Case "b" : s += ControlChars.Back
                    Case "f" : s += ControlChars.FormFeed
                    Case "n" : s += ControlChars.Lf
                    Case "r" : s += ControlChars.Cr
                    Case "t" : s += ControlChars.Tab
                    Case "u"
                        Dim remainingLength As Integer = json.Length - index
                        If remainingLength >= 4 Then
                            ' fetch the next 4 chars
                            Dim unicodeCharArray(4) As Char
                            Array.Copy(json, index, unicodeCharArray, 0, 4)
                            ' parse the 32 bit hex into an integer codepoint
                            Dim codePoint As UInteger = UInt32.Parse(New String(unicodeCharArray), NumberStyles.HexNumber)
                            ' convert the integer codepoint to a unicode char and add to string
                            s += Char.ConvertFromUtf32(CInt(codePoint))
                            ' skip 4 chars
                            index += 4
                        Else
                            Exit While
                        End If

                End Select

            Else
                s += c
            End If

        End While

        If Not complete Then
            Return Nothing
        End If

        Return s

    End Function

    Friend Function ParseNumber(ByVal json As Char(), ByRef index As Integer) As Double

        EatWhitespace(json, index)

        Dim lastIndex As Integer = GetLastIndexOfNumber(json, index)
        Dim charLength As Integer = (lastIndex - index) + 1
        Dim numberCharArray(charLength - 1) As Char

        Array.Copy(json, index, numberCharArray, 0, charLength)
        index = lastIndex + 1
        Return Double.Parse(New String(numberCharArray), CultureInfo.InvariantCulture)

    End Function

    Friend Function GetLastIndexOfNumber(ByVal json As Char(), ByVal index As Integer) As Integer

        Dim lastindex As Integer
        For lastindex = index To json.Length - 1
            If "0123456789+-.eE".IndexOf(json(lastindex)) = -1 Then
                Exit For
            End If
        Next
        Return lastindex - 1

    End Function

    Friend Sub EatWhitespace(ByVal json As Char(), ByRef index As Integer)
        Dim test As String = " " + ControlChars.Tab + ControlChars.CrLf
        For i As Integer = index To json.Length - 1
            If (test.IndexOf(json(i)) = -1) Then
                index = i
                Exit For
            End If
        Next
    End Sub

    Friend Function LookAhead(ByVal json As Char(), ByVal index As Integer) As Integer
        Dim saveIndex As Integer = index
        Return NextToken(json, saveIndex)
    End Function

    Friend Function NextToken(ByVal json As Char(), ByRef index As Integer) As Integer

        EatWhitespace(json, index)

        If index = json.Length Then
            Return TOKEN_NONE
        End If

        Dim c As Char = json(index)
        index += 1
        Select Case c
            Case "{" : Return TOKEN_CURLY_OPEN
            Case "}" : Return TOKEN_CURLY_CLOSE
            Case "[" : Return TOKEN_SQUARED_OPEN
            Case "]" : Return TOKEN_SQUARED_CLOSE
            Case "," : Return TOKEN_COMMA
            Case """" : Return TOKEN_STRING
            Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "-"
                Return TOKEN_NUMBER
            Case ":" : Return TOKEN_COLON
        End Select
        index -= 1

        Dim remainingLength As Integer = json.Length - index

        ' false
        If remainingLength >= 5 Then
            If (json(index) = "f" And _
                json(index + 1) = "a" And _
                json(index + 2) = "l" And _
                json(index + 3) = "s" And _
                json(index + 4) = "e") Then
                index += 5
                Return TOKEN_FALSE
            End If
        End If

        ' true
        If remainingLength >= 4 Then
            If (json(index) = "t" And _
                json(index + 1) = "r" And _
                json(index + 2) = "u" And _
                json(index + 3) = "e") Then
                index += 4
                Return TOKEN_TRUE
            End If
        End If

        ' null
        If remainingLength >= 4 Then
            If (json(index) = "n" And _
                json(index + 1) = "u" And _
                json(index + 2) = "l" And _
                json(index + 3) = "l") Then
                index += 4
                Return TOKEN_NULL
            End If
        End If

        Return TOKEN_NONE

    End Function

    Friend Function SerializeObjectOrArray(ByVal objectOrArray As Object, ByVal builder As StringBuilder) As Boolean

        If TypeOf (objectOrArray) Is Hashtable Then
            Return SerializeObject(CType(objectOrArray, Hashtable), builder)
        ElseIf TypeOf (objectOrArray) Is ArrayList Then
            Return SerializeArray(CType(objectOrArray, ArrayList), builder)
        Else
            Return False
        End If

    End Function

    Friend Function SerializeObject(ByVal anObject As Hashtable, ByVal builder As StringBuilder) As Boolean

        builder.Append("{")

        Dim e As IDictionaryEnumerator = anObject.GetEnumerator()
        Dim first As Boolean = True
        While e.MoveNext()
            Dim key As String = e.Key.ToString()
            Dim value As Object = e.Value

            If Not first Then
                builder.Append(", ")
            End If

            SerializeString(key, builder)
            builder.Append(":")
            If Not SerializeValue(value, builder) Then
                Return False
            End If

            first = False
        End While

        builder.Append("}")
        Return True

    End Function

    Friend Function SerializeArray(ByVal anArray As ArrayList, ByVal builder As StringBuilder) As Boolean

        builder.Append("[")

        Dim first As Boolean = True
        For i As Integer = 0 To anArray.Count - 1
            Dim value As Object = anArray(i)

            If Not first Then
                builder.Append(", ")
            End If

            If Not SerializeValue(value, builder) Then
                Return False
            End If

            first = False
        Next

        builder.Append("]")
        Return True

    End Function

    Friend Function SerializeValue(ByVal value As Object, ByVal builder As StringBuilder) As Boolean

        Select Case True
            Case TypeOf (value) Is String
                SerializeString(CType(value, String), builder)

            Case TypeOf (value) Is Hashtable
                SerializeObject(CType(value, Hashtable), builder)

            Case TypeOf (value) Is ArrayList
                SerializeArray(CType(value, ArrayList), builder)

            Case IsNumeric(value)
                SerializeNumber(Convert.ToDouble(value), builder)

            Case TypeOf (value) Is Boolean
                Select Case CType(value, Boolean)
                    Case True : builder.Append("true")
                    Case False : builder.Append("false")
                End Select

            Case value Is Nothing
                builder.Append("null")

            Case Else
                Return False
        End Select
        Return True

    End Function

    Friend Sub SerializeString(ByVal aString As String, ByVal builder As StringBuilder)

        builder.Append(ControlChars.Quote)

        Dim charArray As Char() = aString.ToCharArray()
        For i As Integer = 0 To charArray.Length - 1
            Dim c As Char = charArray(i)
            Select Case c
                Case ControlChars.Quote : builder.Append(ControlChars.Quote)
                Case "\" : builder.Append("\")
                Case ControlChars.Back : builder.Append(ControlChars.Back)
                Case ControlChars.FormFeed : builder.Append(ControlChars.FormFeed)
                Case ControlChars.NewLine : builder.Append(ControlChars.NewLine)
                Case ControlChars.Cr : builder.Append(ControlChars.Cr)
                Case ControlChars.Tab : builder.Append(ControlChars.Tab)
                Case Else
                    Dim codepoint As Integer = Convert.ToInt32(c)
                    If (codepoint >= 32) And (codepoint <= 126) Then
                        builder.Append(c)
                    Else
                        builder.Append(Chr(codepoint))
                    End If
            End Select
        Next

        builder.Append("\""")
    End Sub

    Friend Sub SerializeNumber(ByVal number As Double, ByVal builder As StringBuilder)
        builder.Append(Convert.ToString(number, CultureInfo.InvariantCulture))
    End Sub

    '/// <summary>
    '/// Determines if a given object is numeric in any way
    '/// (can be integer, double, etc). VB has no pretty way to do this.
    '/// </summary>
    Friend Shared Function IsNumeric(ByVal o As Object) As Boolean
        Try
            Return Double.TryParse(o.ToString(), False)
        Catch
            Return False
        End Try
        Return True
    End Function

End Class
